home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Microsoft Internet Strate…Tools for the Enterprise
/
Microsoft Internet Strategy & Tools for the Enterprise.iso
/
content
/
devel.tls
/
icp
/
ftpexpl.exe
/
EXP_FCNS.BAS
< prev
next >
Wrap
BASIC Source File
|
1996-03-09
|
64KB
|
1,105 lines
Attribute VB_Name = "Explorer_fcns"
Option Explicit
'------------------------------------------------------------
Sub FillClipBoard(FileList As ListView, ClipBoard() As String)
'------------------------------------------------------------
Dim sItem As ListItem
Dim i As Long
'------------------------------------------------------------
i = 0 ' Init Array Counter
For Each sItem In FileList.ListItems ' Search FileList Fast...
If sItem.Selected Then ' Is Item Selected
ReDim Preserve ClipBoard(i) ' Resize ClipBoard Array
ClipBoard(i) = sItem.Key ' Copy Selected Object
i = i + 1 ' Increment Array Counter...
End If
Next ' Next Item In List
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
Sub GetXYFromTag(sTag As String, x As Single, y As Single)
Dim pos As Integer
pos = InStr(1, sTag, ",") ' Search For Comma Sepparator
If pos > 0 Then ' If Comma found
x = CLng(Mid(sTag, 1, pos - 1)) ' Extract X position
y = CLng(Mid(sTag, pos + 1)) ' Extract y position
End If
End Sub
'------------------------------------------------------------
Function RenameKey(cNode As Object, NewKey As String) As Boolean
' Renames cNode's Existing Key To NewKey
'------------------------------------------------------------
Dim cKey As String ' Current Node Key
'------------------------------------------------------------
RenameKey = False ' Set Default Return Code
On Error GoTo ErrorHandler ' Enable Error Handling
cNode.Key = NewKey ' Rename Key
RenameKey = True ' Return Success
Exit Function ' Exit
'------------------------------------------------------------
ErrorHandler: ' Error Handler
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Error
Exit Function ' Return Error
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function vRenameFile(cItem As Object, NewName As String, FTP As Variant, CallBack As Variant, Refresh As Boolean) As Boolean
' Renames CurFileName in an existing directory to NewName
'------------------------------------------------------------
Dim ItemType As String ' Current Item/File Type
Dim Prefix As String ' Key Prefix...
Dim OldKey As String ' Save cItem's Current Key Value
Dim NewKey As String ' cItem's New Key Value
Dim CurFile As String ' Current File
Dim CurPath As String ' Current Path
Dim i As Long ' Loop Counter
Dim rc As Long ' Function Return Code
Dim ePath As Long ' End Of Path String Position
Dim FTPIdx As Long ' FTP Control Index
'------------------------------------------------------------
vRenameFile = False ' Set Default Return Code.
On Error GoTo vRenameError ' Enable Error Handling
OldKey = cItem.Key ' Save cItem's Key
ItemType = ExtractPartFromNode(cItem, NODETYPEID) ' Get Node Type
FTPIdx = CLng(ExtractPartFromNode(cItem, CTLINDEX)) ' Extract FTP Control Index ID...
CurFile = ExtractPartFromNode(cItem, FULLNAME) ' Extract Full File Name
CurPath = ExtractPartFromNode(cItem, PATHNAME) ' Extract Path Name
Prefix = ExtractPartFromNode(cItem, FULLPREFIX) ' Extract Full Prefix
NewKey = Prefix & CurPath & NewName ' Create New Key Name
If Not RenameKey(cItem, NewKey) Then GoTo vRenameError ' Handle Error
Screen.MousePointer = vbHourglass ' Show HourGlass
'------------------------------------------------------------
Select Case ItemType ' Determine File Type
'------------------------------------------------------------
Case ftMCFILE, ftNWFILE, dtMCDIR, dtNWDIR ' My Computer & Network UNC Files & Dirs
'------------------------------------------------------------
Name CurFile As CurPath & NewName ' Rename File...
'------------------------------------------------------------
Case ftINFILE, dtINDIR ' FTP Internet File
'------------------------------------------------------------
CallBack(FTPIdx) = FTPRENAMEFILE ' Set Connection CallBack Flag
' Rename File From CurFile To NewName...
rc = FTP(FTPIdx).RenameFile(CurFile, CurPath & NewName)
Do While (CallBack(FTPIdx) = FTPRENAMEFILE) ' Wait For Connection Response
DoEvents ' Jump Up And Down On The Message Queue
Loop ' Check Status Of Control
If (CallBack(FTPIdx) = FTPERROR) Then GoTo vRenameError ' Handle Error
'------------------------------------------------------------
Case Else ' Type Not Supported
'------------------------------------------------------------
GoTo vRenameError ' Handle Error
'------------------------------------------------------------
End Select
'------------------------------------------------------------
' Set Refresh Flag = True If Item Type Was A Directory
Refresh = ((ItemType = dtMCDIR) Or (ItemType = dtNWDIR) Or (ItemType = dtINDIR))
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
vRenameFile = True ' Return Success
Exit Function ' Exit With Error...
'------------------------------------------------------------
vRenameError: ' Handle Error
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Error
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
If (cItem.Key <> OldKey) Then ' Has cNode's Key Changed?
cItem.Key = OldKey ' Restore cNode's Key
End If
Exit Function ' Exit
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function ExtractPartFromNode(NodeX As Object, PartType As Integer) As String
'------------------------------------------------------------
Dim i As Long ' Loop Index
Dim NodeType As String ' Node Type
Dim FullFileName As String ' File & Path Name
Dim Tok As String * 1 ' Path Separator Token
Dim pos As Long ' Position Of FileName
'------------------------------------------------------------
ExtractPartFromNode = "" ' Set Default Return Code
Select Case PartType
Case PARENTFORMID ' Form Id
ExtractPartFromNode = Mid(NodeX.Key, 1, NODEFORMIDLEN) ' Extract Parent Form Id
Case NODETYPEID ' Node Type
ExtractPartFromNode = Mid(NodeX.Key, (NODEFORMIDLEN + 1), NODEIDLEN) ' Extract NodeType Id
Case CTLINDEX ' FTP Control Index
ExtractPartFromNode = Mid(NodeX.Key, (NODEPREFIXLEN + 1), NODEFTPIDXLEN) ' Extract FTP Control Index
Case FULLPREFIX ' Full Prefix
ExtractPartFromNode = Mid(NodeX.Key, 1, (NODEPREFIXLEN + NODEFTPIDXLEN)) ' Extract Full Prefix
Case FULLNAME ' Extract Full Path\File Name
ExtractPartFromNode = Mid(NodeX.Key, (NODEPREFIXLEN + NODEFTPIDXLEN + 1)) ' Extract Full File & Path Name
Case liFILENAME, PATHNAME ' Extract FileName or Extract Path Only
NodeType = Mid(NodeX.Key, (NODEFORMIDLEN + 1), NODEIDLEN) ' Extract NodeType Id
FullFileName = Mid(NodeX.Key, (NODEPREFIXLEN + NODEFTPIDXLEN + 1)) ' Extract Full File & Path Name
If ((NodeType = ftINFILE) Or (NodeType = dtINDIR)) Then ' Internet File or Path
Tok = "/" ' Internet Path Token
Else
Tok = "\" ' Internet Path Token
End If
For i = (Len(FullFileName) - 1) To 1 Step -1 ' Step Backwards Through File Name
If Mid(FullFileName, i, 1) = Tok Then ' Is Token Found
If (PartType = liFILENAME) Then ' If Extracting File Name
ExtractPartFromNode = Mid(FullFileName, (i + 1)) ' Return File Name
Exit For ' Exit Loop
ElseIf (PartType = PATHNAME) Then ' If Extracting File Path
ExtractPartFromNode = Mid(FullFileName, 1, i) ' Return File Path
Exit For ' Exit Loop
End If
End If
Next ' Get Next Charicter
End Select
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function ExtractPartFromStr(NodeX As String, PartType As Integer) As String
'------------------------------------------------------------
Dim i As Long ' Loop Index
Dim NodeType As String ' Node Type
Dim FullFileName As String ' File & Path Name
Dim Tok As String * 1 ' Path Separator Token
Dim pos As Long ' Position Of FileName
'------------------------------------------------------------
ExtractPartFromStr = "" ' Set Default Return Code
Select Case PartType
Case PARENTFORMID ' Form Id
ExtractPartFromStr = Mid(NodeX, 1, NODEFORMIDLEN) ' Extract Parent Form Id
Case NODETYPEID ' Node Type
ExtractPartFromStr = Mid(NodeX, (NODEFORMIDLEN + 1), NODEIDLEN) ' Extract NodeType Id
Case CTLINDEX ' FTP Control Index
ExtractPartFromStr = Mid(NodeX, (NODEPREFIXLEN + 1), NODEFTPIDXLEN) ' Extract FTP Control Index
Case FULLPREFIX ' Full Prefix
ExtractPartFromStr = Mid(NodeX, 1, (NODEPREFIXLEN + NODEFTPIDXLEN)) ' Extract Full Prefix
Case FULLNAME ' Extract Full Path\File Name
ExtractPartFromStr = Mid(NodeX, (NODEPREFIXLEN + NODEFTPIDXLEN + 1)) ' Extract Full File & Path Name
Case liFILENAME, PATHNAME ' Extract FileName or Extract Path Only
NodeType = Mid(NodeX, (NODEFORMIDLEN + 1), NODEIDLEN) ' Extract NodeType Id
FullFileName = Mid(NodeX, (NODEPREFIXLEN + NODEFTPIDXLEN + 1)) ' Extract Full File & Path Name
If ((NodeType = ftINFILE) Or (NodeType = dtINDIR)) Then ' Internet File or Path
Tok = "/" ' Internet Path Token
Else
Tok = "\" ' Internet Path Token
End If
For i = (Len(FullFileName) - 1) To 1 Step -1 ' Step Backwards Through File Name
If Mid(FullFileName, i, 1) = Tok Then ' Is Token Found
If (PartType = liFILENAME) Then ' If Extracting File Name
ExtractPartFromStr = Mid(FullFileName, (i + 1)) ' Return File Name
Exit For ' Exit Loop
ElseIf (PartType = PATHNAME) Then ' If Extracting File Path
ExtractPartFromStr = Mid(FullFileName, 1, i) ' Return File Path
Exit For ' Exit Loop
End If
End If
Next ' Get Next Charicter
End Select
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function vCopyFile(sNode As String, dNode As String, FTP As Variant, CallBack() As Integer) As Boolean
'------------------------------------------------------------
Dim sType As String ' Source Node File Type
Dim dType As String ' Destination Node File Type
Dim sName As String ' Source Full File Name
Dim dName As String ' Destination Full File Name
Dim sFTPIdx As Long ' Source FTP Control Index
Dim dFTPIdx As Long ' Dest FTP Control Index
Dim sFilePath As String ' Source File Path(Only)
Dim dFilePath As String ' Destination File Path(Only)
Dim sFileName As String ' Source File Name(Only)
Dim dFileName As String ' Destination File Name(Only)
Dim TempPath As String ' Environment Temp Path
Dim rc As Long ' Function Return Code
'------------------------------------------------------------
On Error GoTo vCopyError ' Enable Error Handling
vCopyFile = False ' Set Default Return Code.
sType = ExtractPartFromStr(sNode, NODETYPEID) ' Get Source Node Type
dType = ExtractPartFromStr(dNode, NODETYPEID) ' Get Destination Node Type
sFTPIdx = CLng(ExtractPartFromStr(sNode, CTLINDEX)) ' Get FTP Control Index From Source
dFTPIdx = CLng(ExtractPartFromStr(dNode, CTLINDEX)) ' Get FTP Control Index From Dest
sFileName = ExtractPartFromStr(sNode, liFILENAME) ' Get File Name
sFilePath = ExtractPartFromStr(sNode, PATHNAME) ' Get Path Only
Select Case dType
Case ntMCRCHILD, ntNWRCHILD, ntMCCHILD, _
ntNWCHILD, dtMCDIR, dtNWDIR ' Dest Node Is A Directory, Use Full Name
dFilePath = ExtractPartFromStr(dNode, FULLNAME) & "\"
Case ntINRCHILD, ntINCHILD, dtINDIR
dFilePath = ExtractPartFromStr(dNode, FULLNAME) & "/"
Case ftMCFILE, ftNWFILE, ftINFILE ' Dest Node Is A File, Use Path Only
dFilePath = ExtractPartFromStr(dNode, PATHNAME)
Case Else ' Invalid Node Type...
GoTo vCopyError ' Enable Error Handling
End Select
'------------------------------------------------------------
Select Case sType & dType
' Determine Copy Type (Source) ==> (Dest)
'------------------------------------------------------------
Case ftMCFILE & ftMCFILE, ftMCFILE & dtMCDIR, _
ftMCFILE & ftNWFILE, ftMCFILE & dtNWDIR, _
ftNWFILE & ftMCFILE, ftNWFILE & dtMCDIR, _
ftNWFILE & ftNWFILE, ftNWFILE & dtNWDIR
' [PC => PC] - VB FileCopy
'------------------------------------------------------------
' Copy File...
FileCopy sFilePath & sFileName, dFilePath & sFileName
'------------------------------------------------------------
Case ftINFILE & ftMCFILE, ftINFILE & dtMCDIR, _
ftINFILE & ftNWFILE, ftINFILE & dtNWDIR
' [FTP => PC] - FTP GetFile
'------------------------------------------------------------
' GetFile - Copy File From Server...
rc = FFtpGetFile(sFilePath & sFileName, _
dFilePath & sFileName, _
FTP(sFTPIdx), CallBack(sFTPIdx))
If Not rc Then GoTo vCopyError ' Handle Error
'------------------------------------------------------------
Case ftMCFILE & ftINFILE, ftMCFILE & dtINDIR, _
ftNWFILE & ftINFILE, ftNWFILE & dtINDIR
' [PC => FTP] - FTP PutFile
'------------------------------------------------------------
' PutFile - Copy File To Server...
rc = FFtpPutFile(sFilePath & sFileName, _
dFilePath & sFileName, _
FTP(dFTPIdx), CallBack(dFTPIdx))
If Not rc Then GoTo vCopyError ' Handle Error
'------------------------------------------------------------
Case ftINFILE & ftINFILE, ftINFILE & dtINDIR
' [FTP => FTP] - FTP GetFile & PutFile
'------------------------------------------------------------
TempPath = Space(255) ' Initialize TempPath Variable...
Call GetTempPath(255, TempPath) ' Get Temporary Path
TempPath = Trim(TempPath) ' Trim Var
If (Mid(TempPath, Len(TempPath), 1) = vbNullChar) Then TempPath = Mid(TempPath, 1, Len(TempPath) - 1)
If (TempPath = "") Then TempPath = App.Path & "\" ' If TempPath Invalid The Use Working Directory
'------------------------------------------------------------
' Copy File From FTP Server(src) To Temp Directory
'------------------------------------------------------------
rc = FFtpGetFile(sFilePath & sFileName, _
TempPath & sFileName, _
FTP(sFTPIdx), CallBack(sFTPIdx)) ' GetFile - Copy File From Server...
If Not rc Then GoTo vCopyError ' Handle Error
'------------------------------------------------------------
' Copy File From Temp Directory To FTP Server(dest)
'------------------------------------------------------------
rc = FFtpPutFile(TempPath & sFileName, _
dFilePath & sFileName, _
FTP(dFTPIdx), CallBack(dFTPIdx)) ' PutFile - Copy File To Server...
Kill TempPath & sFileName ' Delete Temp File
If Not rc Then GoTo vCopyError ' Handle Error
'------------------------------------------------------------
End Select
'------------------------------------------------------------
vCopyFile = True ' Return Success
Exit Function ' Exit
'------------------------------------------------------------
vCopyError: ' Handle Errors
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Error...
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function FFtpGetFile(src As String, dest As String, FTP As FTPCT, CallBack As Integer) As Boolean
'------------------------------------------------------------
Dim rc As Long ' Function Return Code
'------------------------------------------------------------
On Error GoTo 0
Screen.MousePointer = vbHourglass ' Set Mouse Pointer
CallBack = FTPGETFILE ' Set CallBack Flag
' FTP.DocOutput.filename = dest
Call FTP.GetFile(src, dest) ' GetFile - Copy File From Server...
Do While (CallBack = FTPGETFILE) ' Wait For File Copy Complete
DoEvents ' Jump Up And Down On The Message Queue
Loop ' Continue Checking Status
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
FFtpGetFile = (CallBack = FTPSUCCESS) ' Return True If File Copy Successful
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function FFtpPutFile(src As String, dest As String, FTP As FTPCT, CallBack As Integer) As Boolean
'------------------------------------------------------------
Dim rc As Long ' Function Return Code
'------------------------------------------------------------
Screen.MousePointer = vbHourglass ' Set Mouse Pointer
CallBack = FTPPUTFILE ' Set CallBack Flag
' FTP.DocInput.filename = src
Call FTP.PutFile(src, dest) ' FTP Put File - Copy File To Server...
Do While (CallBack = FTPPUTFILE) ' Wait For File Copy Complete
DoEvents ' Jump Up And Down On The Message Queue
Loop ' Continue Checking Status
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
FFtpPutFile = (CallBack = FTPSUCCESS) ' Return True If File Copy Successful
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Function vDeleteFile(cItem As ListItem, FTP As Variant) As Boolean
' Deletes The Current File Associated With cItem
'------------------------------------------------------------
Dim ItemType As String ' Current Item/File Type
Dim CurFile As String ' Current File
Dim rc As Long ' Function Return Code
Dim FTPIdx As Long ' FTP Control Index
'------------------------------------------------------------
On Error GoTo vDeleteError ' Enable Error Handling
vDeleteFile = False ' Set Default Return Code.
ItemType = Mid(cItem.Key, (NODEFORMIDLEN + 1), NODEIDLEN) ' Extract Node Type...
'------------------------------------------------------------
' Confirm Delete
'------------------------------------------------------------
Select Case ItemType
Case ftMCFILE, ftNWFILE, ftINFILE
rc = MsgBox("Are you sure you want to delete '" & cItem & "'?", _
vbInformation + vbYesNo, "Confirm File Delete")
Case dtMCDIR, dtNWDIR, dtINDIR
rc = MsgBox("Are you sure you want to remove the folder '" & cItem & _
"' and all of its contents?", vbInformation + vbYesNo, _
"Confirm Folder Delete")
End Select
If (rc <> vbYes) Then Exit Function ' User Changed There Mind.
'------------------------------------------------------------
' Delete File/Directories
'------------------------------------------------------------
' Extract Full File Name
CurFile = Mid(cItem.Key, (NODEPREFIXLEN + NODEFTPIDXLEN + 1))
' Extract FTP Control Index Value
FTPIdx = CLng(Mid(cItem.Key, (NODEPREFIXLEN + 1), NODEFTPIDXLEN))
Select Case ItemType ' Determine File Type
Case ftMCFILE, ftNWFILE ' My Computer & Network UNC Files
Kill CurFile ' Delete File...
Case dtMCDIR, dtNWDIR ' My Computer & Network UNC Dirs
'<<< Need To Make This More Robust >>>'
Kill CurFile & "\*.*" ' Delete All Files...
RmDir CurFile ' Remove Directory
Case ftINFILE ' FTP Internet File
rc = FTP(FTPIdx).DeleteFile(CurFile) ' Delete Current File
'<<< Need To Make This More Robust >>>'
' Validate Delete
Case dtINDIR ' FTP Internet Directory
rc = FTP(FTPIdx).DeleteFile(CurFile) ' Delete Current File
'<<< Need To Make This More Robust >>>'
' Validate Delete
Case Else ' Type Not Supported
Exit Function ' Exit With Error...
End Select
'------------------------------------------------------------
' cItem.Remove ' Kill Node Key
vDeleteFile = True ' Return Success
Exit Function ' Exit With Error...
'------------------------------------------------------------
vDeleteError: ' Handle Error
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Error
Exit Function ' Exit
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Sub LoadLocalDrives(TV As TreeView, ParentNode As Node)
'------------------------------------------------------------
Dim Drive As Long ' Drive ID
Dim sDrive As String * 1 ' Drive Letter
Dim DriveType As Long ' Drive Type Icon Value
Dim FormID As String * NODEFORMIDLEN ' Form ID String Value
Dim NewNode As String ' New Child Node ID
Dim rc As Long ' Return Code Variable
'------------------------------------------------------------
On Error Resume Next ' Resume If Key Already Exists...
FormID = Mid(TV.Nodes(1).Key, 1, NODEFORMIDLEN) ' Extract Form ID From First Tree Node...
For Drive = Asc("A") To Asc("Z") ' For Each Drive Letter
sDrive = Chr$(Drive) ' Convert Drive ID To String
NewNode = FormID & ntMCRCHILD & NULLIDX & sDrive & ":" ' Create NewNode Key
If GetDriveInfo(sDrive, DriveType) Then ' Get Drive Type Icon Value
Call TV.Nodes.Add(ParentNode, tvwChild, _
NewNode, "(" & sDrive & ":" & ")", _
DriveType) ' Add Node To Tree...
Else
Call TV.Nodes.Remove(NewNode) ' Otherwise Remove Node From TreeView...
End If
Next ' Check Next Drive...
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
'------------------------------------------------------------
Public Function GetDriveInfo(ByVal Drive As String, drvType As Long) As Boolean
'------------------------------------------------------------
Dim sDrive As String
'------------------------------------------------------------
GetDriveInfo = False ' Set Default Return Code
sDrive = Drive & ":\"
Select Case GetDriveType(sDrive)
Case DRIVE_CDROM
drvType = TCDROMDRIVE
Case DRIVE_FIXED
drvType = THARDDRIVE
Case DRIVE_REMOTE
drvType = TNETDRIVE
Case DRIVE_RAMDISK
drvType = TRAMDRIVE
Case DRIVE_REMOVABLE
' drvType = TFLOPPY514
drvType = TFLOPPY35
Case Else
Exit Function
End Select
GetDriveInfo = True ' Set Default Return Code
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Sub GetDirs(Tree As TreeView, NodeX As Node, FTP As FTPCT, Refresh As Boolean)
'------------------------------------------------------------
Dim NodeType As String ' Type Of Node Used...
Dim NodeKey As String ' Unique Key For New Tree Node...
Dim FormID As String ' Form Id
Dim RootDir As String ' Root Directory Of SubDirectory
Dim ChildDir As String ' New Child Directory
Dim FTPListRS As String ' Name List Results Set
Dim FTPItem As String ' FTP File Or Directory Detail Line
Dim FileInfo As FTPFileInfo ' Contains FTP File/Dir Information.
Dim Idx As String * NODEFTPIDXLEN ' FTP Control Index
Dim eoLine As Long ' End Of Line
Dim Attr As Integer ' File Attributes Var...
'------------------------------------------------------------
On Error GoTo CheckError ' Enable Error Handler
With Tree.Nodes ' Shorten Ole Reference...
If Refresh Then ' Refresh Child Nodes...
Do While Not (NodeX.Child Is Nothing) ' While Child Nodes Exist
.Remove NodeX.Child.Index ' Remove Them...
Loop ' Next Child
Else
If (NodeX.Children > 0) Then Exit Sub ' If Children Exist Then Don't Redo
End If
FormID = ExtractPartFromNode(NodeX, PARENTFORMID) ' Parent Form ID (i.e. Tag Value)
NodeType = ExtractPartFromNode(NodeX, NODETYPEID) ' Get Node Type
Idx = ExtractPartFromNode(NodeX, CTLINDEX) ' Extract FTP Control Index ID...
RootDir = ExtractPartFromNode(NodeX, FULLNAME) ' Extract Root Directory Path
Select Case NodeType ' Build Unique Node ID Prefix
Case ntMCRCHILD, ntMCCHILD ' My Computer Children
NodeKey = FormID & ntMCCHILD & NULLIDX ' Network UNC Child Node ID Prefix
Case ntNWRCHILD, ntNWCHILD ' Network Unc Children
NodeKey = FormID & ntNWCHILD & NULLIDX ' My Computer Child Node ID Prefix
Case ntINRCHILD, ntINCHILD ' Internet FTP Children
NodeKey = FormID & ntINCHILD & Idx ' Internet FTP Child Node ID Prefix
End Select
Select Case NodeType ' Handle Each File System Type
'------------------------------------------------------------
Case ntMCRCHILD, ntMCCHILD, ntNWRCHILD, ntNWCHILD ' My Computer & Network Unc Files...
'------------------------------------------------------------
RootDir = RootDir & "\" ' Add Directory Separator
ChildDir = Dir$(RootDir, vbDirectory) ' Start Search For Sub Directories
Do While (ChildDir <> "") ' While More Directories
If ((ChildDir <> ".") And (ChildDir <> "..")) Then ' Ignore Current and Previous Directories...
Attr = GetAttr(RootDir & ChildDir) ' Extract Attributes...
If (Attr = vbDirectory) Then ' Is This A Directory...
Call .Add(NodeX.Key, tvwChild, _
NodeKey & RootDir & ChildDir, _
ChildDir, TFOLDERCLOSED) ' Add New Directory Node To Tree.
End If
End If
ChildDir = Dir$ ' Get Next Directory
Loop ' Loop For More Directories...
Exit Sub ' Exit
'------------------------------------------------------------
Case ntINRCHILD, ntINCHILD ' Internet FTP Children
'------------------------------------------------------------
RootDir = RootDir & "/" ' Add Directory Separator
FTPListRS = FTP.Tag ' Copy NameList() Results
If (UCase(Mid(FTPListRS, 1, 5)) = "TOTAL") Then ' Is First Line Invalid...
eoLine = InStr(1, FTPListRS, vbCrLf) ' Calculate eoLine Position
FTPListRS = Mid(FTPListRS, eoLine + 2) ' Remove First Line...
End If
Do While (FTPListRS <> "") ' While More Items Exits In List...
eoLine = InStr(1, FTPListRS, vbCrLf) ' Calculate eoLine Position
If (eoLine < 1) Then eoLine = Len(FTPListRS) ' Validate/Adjust eoLine
FTPItem = Mid(FTPListRS, 1, eoLine - 1) ' Get Next Line
If (FTPItem = "") Then Exit Do ' Next Line Not Found
Call ParseFTPFileInfo(FTPItem, FileInfo) ' Parse File Info...
' Is Current Item A Sub Directory Only...
Select Case FileInfo.fType
Case FTFOLDER
If ((FileInfo.fName <> ".") And (FileInfo.fName <> "..")) Then
Call .Add(NodeX.Key, tvwChild, _
NodeKey & RootDir & FileInfo.fName, _
FileInfo.fName, TFOLDERCLOSED) ' Add New Directory Node To Tree.
End If
Case FTSHORTCUT
Call .Add(NodeX.Key, tvwChild, _
NodeKey & RootDir & FileInfo.fName, _
FileInfo.fName, TSHORTCUTCLOSED) ' Add New Directory Node To Tree.
End Select
FTPListRS = Mid(FTPListRS, eoLine + 2) ' Remove Previous Item & vbCrLf Char
Loop ' Process Next Item In List
Exit Sub ' Exit
'------------------------------------------------------------
End Select
End With ''' Tree.Nodes
'------------------------------------------------------------
CheckError:
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Error Messages...
Resume Next ' Ignore Error And Resume..
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
'------------------------------------------------------------
Sub ParseFTPFileInfo(SearchString As String, FileInfo As FTPFileInfo)
'------------------------------------------------------------
Dim Line As String ' Copy Of Search String
ReDim plist(0) As String ' Parse List Array Of Items
Dim pos As Long ' Position Of Next Space
Dim i As Long, j As Long ' Loop Array Variable
Dim dFields As Long ' Number Of Fields In A Date
Dim lBnd As Long, uBnd As Long ' Lower & Upper Bound of pList()
Dim sDate As String ' Date Text...
Dim char As String * 1 ' Single Char Var...
'------------------------------------------------------------
On Error GoTo ParseError ' Enable Error Handling...
Line = Trim(SearchString) ' Make Copy Of SearchString, Buffer w/1 space
'------------------------------------------------------------
' Parse Line Into A List
'------------------------------------------------------------
Do While (Line <> "") ' While Line Is Not Empty
For j = 1 To Len(Line) ' For Each Char In Line
Select Case Mid(Line, j, 1) ' Evaluate Next Char
Case " ", vbNullChar, vbCr, vbLf, vbBack, _
vbTab, vbVerticalTab, vbFormFeed ' Look For weird Char.s
Case Else ' Done Searching...
If (j > 1) Then Line = Mid(Line, j) ' Extract Extra Char.s Out
Exit For ' Exit For Loop
End Select
Next ' Next Char =>
pos = InStr(1, Line, " ") - 1 ' Get Position Of Next Space
If (pos < 1) Then pos = Len(Line) ' Validate/Adjust Pos
ReDim Preserve plist(i) As String ' Expand pList Size...
plist(i) = Mid(Line, 1, pos) ' Parse Next Item From Line
i = i + 1 ' Increment Counter
Line = LTrim(Mid(Line, pos + 2)) ' Cut All Preceding Spaces Only...
Loop ' Continue Parsing Line
lBnd = LBound(plist) ' Get Lower Bound Of pList
uBnd = UBound(plist) ' Get Upper Bound Of pList
FileInfo.fDateTime = "" ' Clear DateTime Value...
FileInfo.fAccess = "" ' Clear Access Type
FileInfo.fSize = -1 ' Init File Size
FileInfo.fName = plist(uBnd) ' AssUMe Name Is Last Entry
FileInfo.fType = FTFILE ' Set File Type As File(Default)
'------------------------------------------------------------
' Look For Unix Style Security Info...
'------------------------------------------------------------
char = Mid(plist(lBnd), 1, 1)
Select Case char
Case "d", "D" ' Directory
FileInfo.fType = FTFOLDER
Case "l", "L" ' ShortCut
FileInfo.fType = FTSHORTCUT
Case "-", "S", "T" ' Regular File
FileInfo.fType = FTFILE
Case "c", "C" ' Charicter Device File
FileInfo.fType = FTCHARDEV
Case "b", "B" ' Block Device File
FileInfo.fType = FTBLOCKDEV
Case "s" ' Unix Domain Socket (BSD)
FileInfo.fType = FTUNIXDS
Case "p", "P" ' Named Pipe (ATT)
FileInfo.fType = FTNAMEDPIPE
End Select
Select Case char
Case "d", "l", "c", "b", "p", "s", "-", _
"D", "L", "C", "B", "P", "S", "T"
FileInfo.fAccess = plist(lBnd) ' Copy Access Type
End Select
'------------------------------------------------------------
' Evaluate Each Member In The List To Determine Its Content
'------------------------------------------------------------
For i = (uBnd - 1) To (lBnd + 1) Step -1 ' Evaluate Each Item From Right To Left
If (FileInfo.fDateTime = "") Then ' Has A Date Been Found Yet?
If (i > lBnd) Then ' Are There >= 2 Items In List
sDate = plist(i - 1) & " " & plist(i) ' Copy Date String
If IsDate(sDate) Then dFields = 1 ' 2 Date Fields
ElseIf ((i - 1) > lBnd) Then ' Are There >= 3 Items In List
sDate = plist(i - 2) & " " & plist(i - 1) & " " & plist(i) ' Copy Date String
If IsDate(sDate) Then dFields = 2 ' 3 Date Fields
End If
End If
Select Case True ' Determine Information Type
Case (dFields > 0) ' Date Format Found
FileInfo.fDateTime = Format$(sDate, FMTDATETIME) ' Extract Date/Time
i = i - dFields ' Decrement Loop Counter By Num Of Date Fields
sDate = "" ' Clear Var...
dFields = 0 ' Clear Var...
Case plist(i) = FTPDIR ' Microsoft FTP Directory Flag
FileInfo.fType = FTFOLDER ' Set File Type As Directory
Case (IsNumeric(plist(i)) And (FileInfo.fSize = -1)) ' Numeric? and fSize Not Set Yet
FileInfo.fSize = plist(i) ' Assume File Size...
Case plist(i) = FTPSHORTCUT ' ShortCut "->" Found
If (i > lBnd) Then ' Are There >= 2 Items In List
FileInfo.fName = plist(i - 1) ' Copy ShortCut Alias Name
End If
Case Else
End Select
Next ' Next Argument...
Exit Sub ' Exit
'------------------------------------------------------------
ParseError: ' Handle Error
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Error
Resume Next ' Ignore Error And Resume
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
'------------------------------------------------------------
Sub GetFiles(FileList As ListView, NodeX As Node, FTP As FTPCT)
'------------------------------------------------------------
Dim FormID As String ' Parent Form ID
Dim NodeType As String ' Type Of Node Used...
Dim FilePath As String ' Current File Path
Dim cFileName As String ' Current File Or Dir Name
Dim FullFileName As String ' Full Path\File Name
Dim Row As ListItem ' Current ListView Row...
Dim fPfx As String ' File Prefix
Dim dPfx As String ' Directory Prefix
Dim FTPListRS As String ' Name List Results Set
Dim FTPItem As String ' FTP File Or Directory Detail Line
Dim FileInfo As FTPFileInfo ' Contains FTP File/Dir Information.
Dim Idx As String * NODEFTPIDXLEN ' FTP Control Index
Dim eoLine As Long ' End Of Line Position
Dim IconIDX As Integer ' Icon Index...
Dim Attr As Integer ' File, Directory Attributes...
'------------------------------------------------------------
On Error GoTo CheckError ' Handle Errors
With FileList.ListItems ' Enable Early Binding...
FileList.Sorted = False
FormID = Mid(NodeX.Key, 1, NODEFORMIDLEN) ' Get Parent Form ID
NodeType = Mid(NodeX.Key, (NODEFORMIDLEN + 1), NODEIDLEN) ' Get Node Type
Idx = Mid(NodeX.Key, (NODEPREFIXLEN + 1), NODEFTPIDXLEN) ' Extract FTP Control Index ID...
FilePath = Mid(NodeX.Key, (NODEPREFIXLEN + NODEFTPIDXLEN + 1)) ' Extract Root Directory Path
Select Case NodeType
Case ntMCRCHILD, ntMCCHILD ' My Computer
fPfx = FormID & ftMCFILE & Idx ' My Computer File Type
dPfx = FormID & dtMCDIR & Idx ' My Computer Directory Type
Case ntNWRCHILD, ntNWCHILD ' Network Unc
fPfx = FormID & ftNWFILE & Idx ' Network UNC File Type
dPfx = FormID & dtNWDIR & Idx ' Network UNC Directory Type
Case ntINRCHILD, ntINCHILD ' Internet FTP
fPfx = FormID & ftINFILE & Idx ' Internet FTP File Type
dPfx = FormID & dtINDIR & Idx ' Internet FTP Directory Type
End Select
'------------------------------------------------------------
Select Case NodeType ' Handle Each File System Type
'------------------------------------------------------------
' My Computer & Network Unc Files...
Case ntMCRCHILD, ntMCCHILD, ntNWRCHILD, ntNWCHILD
'------------------------------------------------------------
cFileName = Dir(FilePath & "\", vbNormal + vbReadOnly + vbHidden + _
vbSystem + vbArchive + vbDirectory) ' Get First File Name
Do While (cFileName <> "") ' While More Files Exist...
If ((cFileName <> ".") And (cFileName <> "..")) Then
FullFileName = FilePath & "\" & cFileName ' Copy Full File Name
Attr = GetAttr(FullFileName) ' Get Files Attributes...
If (Attr <> vbDirectory) Then
' Add File Name To ListView
Set Row = .Add(, fPfx & FullFileName, cFileName, TFILE, TFILE)
Row.SubItems(LVCOLFILETYPE) = FTFILE ' Add Type To ListView
Else
' Add Directory Name To ListView
Set Row = .Add(, dPfx & FullFileName, cFileName, TFOLDERCLOSED, TFOLDERCLOSED)
Row.SubItems(LVCOLFILETYPE) = FTFOLDER ' Add Type To ListView
End If
' Add File Size To ListView
Row.SubItems(LVCOLFILESIZE) = Str$(FileLen(FullFileName) \ 1024) & "KB"
' Add File Date/Time To ListView
Row.SubItems(LVCOLFILEDATE) = Format$(FileDateTime(FullFileName), FMTDATETIME)
End If
cFileName = Dir ' Get Next File
Loop
'------------------------------------------------------------
Case ntINRCHILD, ntINCHILD ' Internet FTP File System
'------------------------------------------------------------
FTPListRS = FTP.Tag ' Copy NameList() Results
If (UCase(Mid(FTPListRS, 1, 5)) = "TOTAL") Then ' Is First Line Invalid...
eoLine = InStr(1, FTPListRS, vbCrLf) ' Calculate eoLine Position
FTPListRS = Mid(FTPListRS, eoLine + 2) ' Remove First Line...
End If
Do While (FTPListRS <> "") ' While More Items Exits In List...
eoLine = InStr(1, FTPListRS, vbCrLf) ' Calculate eoLine Position
If (eoLine < 1) Then eoLine = Len(FTPListRS) ' Validate/Adjust eoLine
FTPItem = Mid(FTPListRS, 1, eoLine - 1) ' Get Next Line
If (FTPItem = "") Then Exit Do ' Next Line Not Found
Call ParseFTPFileInfo(FTPItem, FileInfo) ' Parse File Info...
If ((FileInfo.fName <> ".") And (FileInfo.fName <> "..")) Then ' If Not [.] or [..]
FullFileName = FilePath & "/" & FileInfo.fName ' Create Full Path\File Name
Select Case FileInfo.fType
Case FTFOLDER ' Directory
' Add Directory Name To ListView
Set Row = .Add(, dPfx & FullFileName, FileInfo.fName, TFOLDERCLOSED, TFOLDERCLOSED)
Case FTSHORTCUT ' ShortCut
' Add ShortCut Directory Name To ListView
Set Row = .Add(, dPfx & FullFileName, FileInfo.fName, TSHORTCUTCLOSED, TSHORTCUTCLOSED)
Case FTFILE, FTCHARDEV, FTBLOCKDEV ' File, Chr Device File, Block Device File
' Add File Name To ListView
Set Row = .Add(, fPfx & FullFileName, FileInfo.fName, TFILE, TFILE)
Case FTUNIXDS, FTNAMEDPIPE ' Unix Domain Socket (BSD)
' Add ShortCute File Name To ListView
Set Row = .Add(, fPfx & FullFileName, FileInfo.fName, TSHORTCUTFILE, TSHORTCUTFILE)
End Select
' Add Type To ListView
Row.SubItems(LVCOLFILETYPE) = FileInfo.fType
' Add File Size To ListView
Row.SubItems(LVCOLFILESIZE) = Str$(CLng(FileInfo.fSize) \ 1024) & "KB"
' Add File Date/Time To ListView
Row.SubItems(LVCOLFILEDATE) = FileInfo.fDateTime
' Add Access Rights To ListView
Row.SubItems(LVCOLFILEACCESS) = FileInfo.fAccess
End If
FTPListRS = Mid(FTPListRS, eoLine + 2) ' Remove Previous Item & vbCrLf Char
Loop ' Process Next Item In List
Exit Sub ' Exit
'------------------------------------------------------------
End Select
'------------------------------------------------------------
FileList.Sorted = True
End With ''' FileList.ListItems
Exit Sub ' Exit
'------------------------------------------------------------
CheckError: ' Error Handler
'------------------------------------------------------------
Debug.Print FullFileName, Err.Number, Err.Description ' Debug Error
Resume Next ' Ignore Error And Resume
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
Public Sub AddFTPConnection(FTP As FTPCT, Tree As TreeView, Frm As Form)
'------------------------------------------------------------
Dim rc As Long ' Return Code
Dim nChild As Node ' Current Child Node
'------------------------------------------------------------
On Error GoTo CleanUp ' Enable Error Handling
Load FTPConnect ' Load FTPConnect Form
FTPConnect.Show vbModal ' Show UNCRemove Form
If (FTPConnect.txtRemoteHost.Text <> "") Then ' If ServerName Exits Then Process...
Screen.MousePointer = vbHourglass ' Show HourGlass
FTP.Connect FTPConnect.txtRemoteHost.Text ' Connect To FTP Server
Do While (FTP.State = prcConnecting) Or _
(FTP.State = prcResolvingHost) Or _
(FTP.State = prcHostResolved) ' Wait For Connection Response
DoEvents ' Jump Up And Down On The Message Queue
Loop ' Check Status Of Control
If (FTP.State <> prcConnected) Then ' Did An Error Occure...
Unload FTP ' Delete Control Instance...
GoTo CleanUp
End If
FTP.UserId = FTPConnect.txtUserName.Text
FTP.Password = FTPConnect.txtPassword.Text
Do While (FTP.State = prcConnected) And _
(FTP.ProtocolState = ftpBase) ' Wait For Connection Response
DoEvents ' Jump Up And Down On The Message Queue
Loop ' Check Status Of Control
FTP.Authenticate
Call Tree.Nodes.Add(Frm.Tag & ntINTERNET & NULLIDX & NTRINTERNET, tvwChild, _
Frm.Tag & ntINRCHILD & Format$(FTP.Index, FMTINDEX) & FTPROOTDIR, _
FTP.RemoteHost, TMYCOMPUTER) ' Add Node To Tree...
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
Else ' Connect Was Canceled
Unload FTP ' Delete Control Instance...
End If
'------------------------------------------------------------
CleanUp: ' Clean Up Environment...
'------------------------------------------------------------
Unload FTPConnect ' Close FTPConnect Form
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
' Resume Next
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
Public Sub RemoveUNCPath(TV As TreeView, UNCNode As Node)
' Removes UNC Path From TreeView Control
'------------------------------------------------------------
Dim i As Integer ' Index Pointer
Dim nChild As Node ' Current Child Node
'------------------------------------------------------------
On Error GoTo CleanUp ' Enable Error Handling
Load UNCRemove ' Load UNCRemove Form
UNCRemove.Caption = "Disconnect Network Path" ' Set Network Path Title
UNCRemove.lbList.Caption = "&Path" ' Set List Label Caption
If (UNCNode.Child Is Nothing) Then ' Are There Any Children
MsgBox "There are no UNC network paths to disconnect.", _
vbInformation, "Windows UNC Networking" ' Display Error Message...
GoTo CleanUp ' Clean Up Environment
End If
Set nChild = UNCNode.Child ' Copy First Child
Do While Not (nChild Is Nothing) ' For Each Available Child
' Add Child Description To ListBox
UNCRemove.lbConnections.AddItem Mid(nChild.Key, (NODEPREFIXLEN + NODEFTPIDXLEN + 1))
Set nChild = nChild.Next ' Point To Next Child
Loop ' Next Child
UNCRemove.lbConnections.Selected(0) = True ' Select First Item In The List
UNCRemove.Show vbModal ' Show UNCRemove Form
If (UNCRemove.lbConnections.ListIndex >= 0) Then ' Is An Item Selected
For i = 0 To UNCRemove.lbConnections.ListCount - 1 ' Browse For Selected Items
If UNCRemove.lbConnections.Selected(i) Then ' Is Item Selected
' Remove Node From TreeView...
Call TV.Nodes.Remove(TV.Parent.Tag & ntNWRCHILD & NULLIDX & _
UNCRemove.lbConnections.List(i)) ' Remove Item
End If
Next ' Next List Item
End If
'------------------------------------------------------------
CleanUp: ' Clean Up Environment...
'------------------------------------------------------------
Unload UNCRemove ' Close UNCRemove Form
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
'------------------------------------------------------------
Public Sub RemoveFTPConnection(TV As TreeView, NodeX As Node, FTP As Variant)
' Removes UNC Path From TreeView Control
'------------------------------------------------------------
Dim i As Integer ' Index Pointer
Dim Inst As Integer ' FTP Control Instance
Dim nChild As Node ' Current Child Node
'------------------------------------------------------------
On Error GoTo CleanUp ' Enable Error Handling
Load UNCRemove ' Load UNCRemove Form
UNCRemove.Caption = "Disconnect FTP Connection" ' Set FTP Connection Title
UNCRemove.lbList.Caption = "&Connection" ' Set List Label Caption
If (NodeX.Child Is Nothing) Then ' Are There Any Children
MsgBox "There are no FTP connections to disconnect.", _
vbInformation, "Windows FTP Networking" ' Display Error Message...
GoTo CleanUp ' Clean Up Environment
End If
Set nChild = NodeX.Child ' Copy First Child
i = 0 ' Init ListBox Index Var.
Do While Not (nChild Is Nothing) ' For Each Available Child
' Add Child Description To ListBox
UNCRemove.lbConnections.AddItem nChild.Text, i
' Add FTP Control Instance
UNCRemove.lbConnections.ItemData(i) = CLng(Mid(nChild.Key, NODEPREFIXLEN + 1, NODEFTPIDXLEN))
i = i + 1 ' Increment Index Counter
Set nChild = nChild.Next ' Point To Next Child
Loop ' Next Child
UNCRemove.lbConnections.Selected(0) = True ' Select First Item In The List
UNCRemove.Show vbModal ' Show UNCRemove Form
If (UNCRemove.lbConnections.ListIndex >= 0) Then ' Is An Item Selected
For i = 0 To (UNCRemove.lbConnections.ListCount - 1) ' Browse For Selected Items
If UNCRemove.lbConnections.Selected(i) Then ' Is Item Selected
FTP(UNCRemove.lbConnections.ItemData(i)).Quit ' Disconnect From FTP Server...
End If
Next ' Next List Item
End If
'------------------------------------------------------------
CleanUp: ' Clean Up Environment...
'------------------------------------------------------------
Unload UNCRemove ' Close UNCRemove Form
'------------------------------------------------------------
End Sub
'------------------------------------------------------------
'------------------------------------------------------------
Public Function AddUNCPath(TV As TreeView) As Boolean
'------------------------------------------------------------
Dim UNCPath As String
Dim msg As String
Dim title As String
Dim def As String
Dim FormID As String * NODEFORMIDLEN ' Form ID String Value
'------------------------------------------------------------
AddUNCPath = False ' Set Default Return Code
On Error Resume Next ' Resume If Key Already Exists...
FormID = Mid(TV.Nodes(1).Key, 1, NODEFORMIDLEN) ' Extract Form ID From First Tree Node...
msg = "Enter The UNC Path That You Want To Connect To..." & vbCrLf & _
"[i.e. \\ServerName\ShareName\...path...\]" ' Input Box Body
title = App.title & " - Attach To UNC Path" ' Input Box Title
def = "\\Products2\Release" ' Input Box Default Value
UNCPath = InputBox(msg, title, def) ' Get UNC Path String...
If (UNCPath = "") Then Exit Function ' User Canceled...
Screen.MousePointer = vbHourglass ' Activate Busy Mouse Pointer
' Validate UNC Path...
If (Dir(UNCPath, vbDirectory) = "") Then ' Is Path Valid Or Available?
Screen.MousePointer = vbDefault ' DeActivate Busy Mouse Pointer
MsgBox "UNC network path is invalid or unavailable.", _
vbInformation, "Windows UNC Networking" ' Display Information To User...
Exit Function ' Error Exit...
End If
Call TV.Nodes.Add(FormID & ntNETWORK & NULLIDX & NTRNETWORK, tvwChild, _
FormID & ntNWRCHILD & NULLIDX & UNCPath, UNCPath, _
TMYCOMPUTER) ' Add Node To Tree...
Screen.MousePointer = vbDefault ' Reset Mouse Pointer
AddUNCPath = True ' Return Success
'------------------------------------------------------------
End Function
'------------------------------------------------------------
'------------------------------------------------------------
'Public Function InstanceFTP(FTPArray As Variant, FTPStream As Variant, CallBack() As Integer) As Long
Public Function InstanceFTP(FTPArray As Variant, CallBack() As Integer) As Long
'------------------------------------------------------------
Dim Ind As Long ' Array Index Var...
'------------------------------------------------------------
InstanceFTP = -1 ' Set Default Value
On Error GoTo InitControl ' IF Error Then Control Is Available
For Ind = 1 To (FTPArray.Count + 1) ' For Each Member In FTPArray()
If (FTPArray(Ind).Index = Ind) Then ' If Control Is Not Valid Then..
End If ' ..A Runtime Error Will Occure
Next ' Search Next Item In Array
'------------------------------------------------------------
InitControl: ' Initialize New Control
'------------------------------------------------------------
On Error GoTo ErrorHandler ' Enable Error Handling...
If (Ind > UBound(CallBack)) Then ' Expand Array Only...
ReDim Preserve CallBack(Ind) ' Resize CallBack Array
End If
Load FTPArray(Ind) ' Create New Member In FTPArray
InstanceFTP = Ind ' Return New Ftpct Index
Exit Function ' Exit
'------------------------------------------------------------
ErrorHandler: ' Handler
'------------------------------------------------------------
Debug.Print Err.Number, Err.Description ' Debug Errors
Resume Next ' Ignore Error And Continue
'------------------------------------------------------------
End Function
'------------------------------------------------------------
